﻿{-# OPTIONS_GHC -XRecordWildCards -XNamedFieldPuns -XDeriveDataTypeable -XTemplateHaskell #-}
module XI.Directory.Types where
import Data.Maybe
import WS.Runtime.Xmlable
import WS.Runtime.DeriveXmlable
import Data.Typeable
import qualified Data.Map as Map
import Control.Arrow
import Data.Function

infixr 5 +|+	
(+|+) :: String -> String -> String
a +|+ b = a ++ "|" ++ b
(+-+) :: String -> String -> String
a +-+ b = a ++ " " ++ b

data XISystem = XISystem {
        party :: Maybe String,
        system :: String
    } deriving (Eq, Ord, Typeable)

instance Show XISystem where
    show (XISystem {..}) 
        | isNothing party = system
        | otherwise = fromJust party +|+ system

defXISystem :: XISystem
defXISystem = XISystem (Just "*") "*"
    
data Scenario = Scenario { scenario_name :: Maybe String, scenario_description :: String, scenario_chains :: [Chain],
    scenario_notes :: Maybe String } deriving (Show, Eq, Typeable)
data Chain = Chain {chain_sender :: Sender, chain_description :: String, chain_receivers :: [Receiver]} deriving (Show, Eq, Typeable)
data CCTabParam = CCTabParam { tpRows :: [Map.Map String String] } deriving (Show, Eq, Typeable, Ord)
data CCModules = CCModules { ccmName :: String, ccmType :: String, ccmParams :: Map.Map String String } deriving (Show, Eq, Typeable, Ord)
data CCParams = CCParams {
        ccParams    :: Map.Map String String, 
        ccTabParams :: Map.Map String CCTabParam,
        ccModules   :: [CCModules]
    } deriving (Show, Eq, Typeable, Ord)
    
data Sender = Sender {
        s_sys :: XISystem, 
        s_cc :: String, 
        s_int :: String, 
        s_descriptions :: (String, String),
        s_cc_params :: Maybe CCParams,
        s_params :: Maybe AdditionalParams
    } deriving (Show, Eq, Typeable)
data Condition = Condition {cond :: String} deriving (Show, Eq, Ord, Typeable) -- undefined !!!
data Receiver = Receiver {r_cond :: Maybe Condition, r_sys :: XISystem, 
        r_description :: String, r_ints :: [RcvInt]} deriving (Show, Eq, Typeable)

data RcvInt = RcvInt {
        ri_cond :: Maybe Condition, 
        r_int :: String, 
        mapping :: Maybe String, 
        r_cc :: String, 
        r_descriptions :: (String, String),
        r_cc_params :: Maybe CCParams, 
        r_params :: Maybe AdditionalParams
    } deriving (Show, Eq, Typeable)
    
data AdditionalParams = AdditionalParams { size :: Maybe Statistics, cnt :: Maybe Integer, cnt_day :: Maybe Statistics, 
        regulations :: Maybe String, allowable_time :: Maybe Integer {- secs -}, features :: Maybe String} deriving (Show, Eq, Ord, Typeable)

blank_ap :: AdditionalParams
blank_ap = AdditionalParams (Just blank_stat) (Just 0) (Just blank_stat) (Just "") (Just 0) (Just "")

data Statistics = Statistics { min_val :: Maybe Integer, max_val :: Maybe Integer, avg_val :: Maybe Float } deriving (Show, Eq, Ord, Typeable)
blank_stat :: Statistics
blank_stat = Statistics (Just 0) (Just 0) (Just 0)

$(deriveXmlableACDef ''XISystem)
$(deriveXmlableACDef ''CCModules)
$(deriveXmlableACDef ''CCTabParam)
$(deriveXmlableACDef ''CCParams)
$(deriveXmlableACDef ''Scenario)
$(deriveXmlableACDef ''Chain)
$(deriveXmlableACDef ''Sender)
$(deriveXmlableACDef ''Condition)
$(deriveXmlableACDef ''Receiver)
$(deriveXmlableACDef ''RcvInt)
$(deriveXmlableACDef ''AdditionalParams)
$(deriveXmlableACDef ''Statistics)

type CCParam = (CCType, AdapterType)
data CCType = CCSender | CCReceiver	deriving (Eq, Ord)
instance Show CCType where
	show CCSender = "S"
	show CCReceiver = "R"
	
ccType :: String -> CCType
ccType "Receiver" = CCReceiver
ccType "Sender" = CCSender
ccType x = error $ "Error in ccType. Type of communication channel could be Receiver or Sender. Now it is" ++ x

def_CCParam :: CCParam
def_CCParam = (CCSender, XI)

data AdapterType = JMS | JDBC | File | FTP | RFC | IDoc | HTTP | XI | SOAP | RNIF | CIDX | Mail | Marketplace | BC deriving (Eq, Ord, Show, Read)

data XIObj = 
    Sc {sc_name :: String, sc_description :: String, sc_ids :: [String]} |
    CC {cc_system :: XISystem, cc_name :: String, cc_description :: String, cc_param :: CCParam, cc_param_map :: Maybe CCParams} |	-- ssys, cc, parameters
    SAgg {sender :: XISystem, sender_int :: String, sa_description :: String, sender_cc :: String} |	-- ssys, sint, cc
    RAgg {sender :: XISystem, receiver :: XISystem, receiver_int :: String, ra_description :: String, receiver_cc :: String} |	-- {-ssys, sint, -}rsys, rint, cc
    RD {sender :: XISystem, sender_int :: String, rd_description :: String, cond_receivers :: [((Maybe Condition), XISystem)]}	| -- ssys, sint, [cond, rsys]
    ID {sender :: XISystem, sender_int :: String, receiver :: XISystem, id_description :: String,
        cond_receiver_ints :: [((Maybe Condition), String, (Maybe String))]} | -- ssys, int, rsys, [cond, rint, mapping]
    IP {ip_system :: XISystem, ip_description :: String}
    deriving (Eq, Ord)

type Configuration = ([Scenario], [XIObj])

readAT :: String -> AdapterType
readAT = read

getAT :: [XIObj] -> XISystem-> String -> AdapterType
getAT ccs s cc = if null ccs' then XI else snd . cc_param . head $ ccs' -- type 'XI' is default
	where 
		ccs' = filter (\(CC {cc_system, cc_name})->(cc_system, cc_name) == (s, cc)) $ filter isCC ccs

isSAreq :: AdapterType -> Bool
isSAreq x = x `elem` [JMS, JDBC, File, FTP, RFC, RNIF, CIDX, Marketplace, BC]

isSAspec :: AdapterType -> Bool
isSAspec x = x `elem` [JMS, JDBC, File, FTP]

getSIfromCC :: XIObj -> Maybe String
getSIfromCC cc
	| isSAreq (snd $ cc_param cc) = Nothing
	| otherwise = Just "http://This.is.not.realised/yet"


-- http://help.sap.com/saphelp_nw70ehp1/helpdata/en/b1/f29e7a56e18a439984a3c6630951d2/content.htm
-- Special Conditions when Using the Sender JMS, JDBC, or File/FTP Adapter
-- In the case of these adapter types, the information about address fields of the message header is determined from the sender agreement that 
-- the communication channel is assigned to. The following conditions apply to sender agreements that use communication channels with these adapter types.
-- ●      The sender channel must not be assigned to more than one sender agreement.
-- ●      No key fields may contain the wildcard character (*).
-- ●      At least the interface (name and namespace) and the sender service must be specified in the sender agreement because the corresponding address fields 
--        in the message must be set uniquely. The remaining fields are optional (see the key fields for the sender agreement).
-- The sender agreement is determined from the sender channel at runtime. The information from the sender agreement is used to construct the address header of the message.

instance Show XIObj where
    show xo = filter (/='"') $ case xo of
        (Sc {sc_description = _, ..}) -> "Sc" +-+ sc_name +-+ "[" ++ (noCB $ show sc_ids) ++ "]"
        (CC {cc_description = _, ..}) -> "CC" +-+ show cc_system +-+ cc_name +-+ (show $ fst cc_param) +-+ (show $ snd cc_param) +-+ show cc_param_map
        (SAgg {sa_description = _, ..}) -> "Agg S" +-+ show sender +-+ show sender_int +-+ sender_cc
        (RAgg {ra_description = _, ..}) -> "Agg R" +-+ show sender +-+ show receiver +-+ show receiver_int +-+ receiver_cc
        (RD {rd_description = _, ..}) -> "RD" +-+ show sender +-+ show sender_int +-+ (noCB $ show $ map (\(x,y)->(fromMb x, y)) cond_receivers)
        (ID {id_description = _, ..}) -> "ID" +-+ show sender +-+ show sender_int +-+ show receiver +-+ 
              (noCB $ show $ map (\(x,y,z)->(fromMb x, y, fromMaybe "-" z)) cond_receiver_ints)
        (IP {ip_description = _, ..}) -> "IP" +-+ show ip_system
        where
            noCB = (map (\x->if x == ',' then ' ' else x)).(filter (`notElem` "[]()"))
            fromMb = fromMaybe "-" . (>>= return . show)

getId :: XIObj -> String
getId x = case x of
    Sc {sc_name} -> "SC" +|+ sc_name
    CC {cc_system, cc_name} -> "CC" +|+ show cc_system +|+ cc_name
    SAgg {sender, sender_int} -> "SAGG" +|+ show sender +|+ sender_int
    RAgg {sender, receiver, receiver_int } -> "RAGG" +|+ show sender +|+ show receiver +|+ receiver_int 
    RD {sender, sender_int} -> "RD" +|+ show sender +|+ sender_int
    ID {sender, sender_int, receiver} -> "ID" +|+ show sender +|+ sender_int +|+ show receiver
    IP {ip_system} -> "IP" +|+ show ip_system
        
determineBy :: XIObj -> XIObj -> XIObj
determineBy y x
    | cmpId x y = 
        if isAggS x then x { sender_int = f "*/*" sender_int }
        else if isAggR x then x {   sender = f defXISystem sender,
                                    receiver = f defXISystem receiver,
                                    receiver_int = f "*/*" receiver_int }
        else if isRD x then x { sender = f defXISystem sender,
                                sender_int = f "*/*" sender_int }
        else if isID x then x { sender = f defXISystem sender,
                                receiver = f defXISystem receiver,
                                sender_int = f "*/*" sender_int }
        else x
    | otherwise = error "Trying to determine by object with different Id"
    where
        f s g = g (if g x == s then y else x)	

isAggS :: XIObj -> Bool
isAggS SAgg {} = True
isAggS _ = False
isRD :: XIObj -> Bool
isRD RD {} = True
isRD _ = False
isID :: XIObj -> Bool
isID ID {} = True
isID _ = False
isAggR :: XIObj -> Bool
isAggR RAgg {} = True
isAggR _ = False
isSc :: XIObj -> Bool
isSc Sc {} = True
isSc _ = False
isCC :: XIObj -> Bool
isCC CC {} = True
isCC _ = False
isIP :: XIObj -> Bool
isIP IP {} = True
isIP _ = False

-- Сравнение идентификаторов. При этом x или y может содержать * и */*
cmpId :: XIObj -> XIObj -> Bool
cmpId = go `on` getId 
	where
        go [] [] = True
        go [] _ = False
        go _ [] = False
        go a b = (cmp' `on` part) a b
        part = second (drop 1) . break (=='|')
        cmp' (a1, a2) (b1, b2) = if any (`elem` ["*", "*/*"]) [a1, b1] || a1 == b1 then go a2 b2 else False
	
